-- | Hexena Monitor an interactive program for analysing
-- executables. This program is similar in look and feel to old
-- "monitors" on old computers.

import Control.Monad.State (StateT, get, modify, runStateT)
import Control.Monad.Reader
import qualified Data.ByteString.Lazy as BL
import Data.IFF
import Data.Int
import Data.Version (showVersion)
import qualified Graphics.UI.SDL as S (Surface, quit)
import Paths_hexena (version)
import System.Environment (getArgs)
import System.Exit
import System.IO (hFlush, stdout)
import Text.ParserCombinators.Parsec
import Text.Printf

import Hexena.Chunks
import Hexena.Text.Hexdump
import Hexena.Obscure (obscureDisplay)

data AppConsts = AppConsts {
  cliFilename :: String
  }

data AppData = AppData {
  iffData :: [T],
  appBody :: BL.ByteString,
  appCount :: Int,
  appBodyPos :: Int64,
  appDisplay :: Maybe S.Surface
  }

type AppState = StateT AppData IO
type AppEnv = ReaderT AppConsts AppState

data HexenaMonCmd = Contents
                  | Monitor (Maybe Int)
                  | Obscure
                  | Quit
                  | Symbol Char
                    deriving Show

symbol :: Parser Char
symbol = oneOf "!#$%&'()*+,-./:;<=>?[\\]^_{|}~"

controlESC :: Parser String
controlESC = char '\x1b' >>= \x -> return [x]

number :: Parser Int
number = read `fmap` many1 digit

hexNumber :: Parser Int
hexNumber = char '$' >> fmap (read . ("0x" ++)) (many1 hexDigit)

someNumber :: Parser Int
someNumber = hexNumber <|> number

spaces1 :: Parser ()
spaces1 = void (many1 space)

cmdContents :: Parser HexenaMonCmd
cmdContents = string "$" >> return Contents

cmdM :: Parser HexenaMonCmd
cmdM = string "m" >> (try $ do { spaces1 >> someNumber >>= return . Monitor . Just }
       <|> return (Monitor Nothing))

cmdObscure :: Parser HexenaMonCmd
cmdObscure = string "obscure" >> return Obscure

cmdQuit :: Parser HexenaMonCmd
cmdQuit = (controlESC <|> string "quit") >> return Quit

cmdSymbol :: Parser HexenaMonCmd
cmdSymbol = Symbol `liftM` symbol

commands :: Parser HexenaMonCmd
commands = cmdContents <|>
           cmdM <|>
           cmdObscure <|>
           cmdQuit <|>
           cmdSymbol

commandLine :: Parser HexenaMonCmd
commandLine = do cmd <- commands
                 eof
                 return cmd

executeCmd :: HexenaMonCmd -> AppEnv ()
executeCmd Quit = liftIO $ putStrLn "Exiting HexenaMonitor" >> exitSuccess
executeCmd (Symbol s) = liftIO $ putStrLn $ "You gave me a Symbol " ++ show s ++ ", but I am not clever enough to know what to do with it..."
executeCmd Contents = get >>= liftIO . print . iffData
executeCmd (Monitor Nothing) = do body <- appBody `liftM` get
                                  pos <- appBodyPos `liftM` get
                                  let hexd = safeHexifyLines pos body
                                  liftIO $ putStrLn $ unlines $ take 16 hexd
                                  modify $ \x -> x { appBodyPos = pos + 0x100 }
executeCmd (Monitor (Just x)) = do body <- appBody `liftM` get
                                   let x' = fromIntegral x
                                   let hexd = safeHexifyLines x' body
                                   liftIO $ putStrLn $ unlines $ take 16 hexd
                                   modify $ \y -> y { appBodyPos = x' + 0x100 }
executeCmd Obscure = do body <- appBody `liftM` get
                        s <- liftIO $ obscureDisplay body
                        modify $ \x -> x { appDisplay = Just s }
executeCmd c = liftIO $ putStrLn (show c ++ "\nOK")

readNparse :: AppEnv ()
readNparse = do
  count <- appCount `liftM` get
  pos <- appBodyPos `liftM` get
  liftIO $ putStr (printf "($%06x) $%x> " pos count) >> hFlush stdout
  x <- liftIO getLine
  case parse commandLine "hxmonitor" x of
    Left err -> liftIO $ print err >> putStrLn "ERROR"
    Right val -> executeCmd val
  -- get >>= put . \x -> x { appCount = (count + 1) }
  modify $ \y -> y { appCount = 1 + appCount y }
  readNparse

runLoop :: AppConsts -> AppData -> IO ((), AppData)
runLoop = runStateT . runReaderT readNparse


quitSDL :: Maybe S.Surface -> IO ()
quitSDL Nothing = return ()
quitSDL (Just _) = S.quit

main :: IO ()
main = do
  fnam <- head `fmap` getArgs
  let banner = "Hexena Monitor V" ++ showVersion version
  putStrLn banner
  putStrLn $ replicate (length banner) '#' ++ "\n"
  (_, iff) <- loadMalwIFF' fnam
  let body = BL.fromChunks [loadBODY iff]
  let consts = AppConsts fnam
  let state = AppData iff body 0 0 Nothing
  (_, lastState) <- runLoop consts state
  print $ length $ iffData lastState
  quitSDL $ appDisplay lastState
